perm filename CLEFS.F4[MSS,LCS] blob sn#128700 filedate 1974-11-02 generic text, type T, neo UTF8
00100	C****  CLEFS, JDRAW, CENTR, LINX, UNPACK, ROFF *********
00200		SUBROUTINE CLEFS
00400		DIMENSION JCLEF(11),MCLEF(700),RCMIN(4),KCLEF(11),NCLEF(350)
00600		COMMON /STF/RSTFAC(8),RSTJC /PLTR/IPLT,RHT,DIS
00700		COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)
00800	      DATA RCMIN/3.3,10.5,7.0,10.5/
00900		EQUIVALENCE (JD,JQ(2)),(RJD,RJQ(2)),(JE,JQ(3)),(JI,JQ(7)),(KK,
01000	     1 KCLEF(11)),(RJF,RJQ(4)),(RJE,RJQ(3)),(JH,JQ(6)),(RJG,RJQ(5))
01100		1,(RJI,RJQ(7)),(NJR,RJQ(8)),(K,JCLEF(11)),(NCLEF,MCLEF(351))
01200		JE=MOD(JE,100)
01300	CC	JEZ=JE
01320		CALL NOZERO(RJF)
01346		IF(RJG.EQ.0)RJG=RJF
01372	C  IF P7 = 0, IT WILL EQUAL P6.
01400		IF(JA.GT.10)GO TO 9
01500		NAME='CLEF0'
01600		IF(JE.LT.10)GO TO 4
01700		RJF=RJF*.3
01800	C  SIZE FACTORS FOR SPECIAL WORDS, ETC. (PPP, MF, CRESC. ETC.)
01900		RJG=RJG*.3
02000		GO TO 4
02100	9	IF(NAME.EQ.NJR)GO TO 4
02200		IF(NAME.NE.0.AND.NJR.EQ.0)GO TO 4
02300		IF(NJR.EQ.0)GO TO 8	
02400	C  TO PICK UP BASIC DRAW NAME FROM P10 
02500		NAME=NJR
02600		GO TO 4
02700	8	TYPE 5
02900	5	FORMAT(' SET P10=1'/)
03200	C  LEADS TO PROPER FILE CALL
03300	4	NM=NAME+2*(JE/10)
03400	C  DRAW0 HAS ITEMS 0→9;  DRAW1, 10→19; ETC. TO DRAW9, 90→99
03500		JEZ=MOD(JE,10)+1
03800	2	IF(NM.EQ.JNM.OR.NM.EQ.KNM)GO TO 30
03900	C  SET P10≠0 TO CHANGE BASIC 'DRAW' NAME.
04000	C  JUMP IF ALREADY IN CORE
04100		IF(LOOKF(NM))GO TO 1111
04200		TYPE 1112,NM
04300		RETURN
04400	1112	FORMAT(1XA5,' -- NOT FOUND')
04405	1111	CALL GETFI2(NM)
04410		IF(KX)GO TO 33
04420		KX=-1
04430		JNM=NM
04600	CC	CALL RDDATA(NM,JCLEF,MCLEF)
04700	CC	CALL IFILE(23,NM)
04900	CC	READ (23)JCLEF,K,(MCLEF(L),L=1,K)
05000		CALL FASTI2(JCLEF,11)
05100		CALL FASTI2(MCLEF,K)
05200	C  NEW DATA READER  6/74 -- 10/74 HOLDS 2 .DMD FILES IF THEY FIT.
05210		IF(K.LE.350)GO TO 30
05220		KX=0
05230		KNM=0
05240		GO TO 30
05250	33	CALL FASTI2(KCLEF,11)
05260		KX=0
05270		IF(KK.GT.350)GO TO 1111
05280	C  JUMP BACK IF IT WON'T FIT.
05290		CALL FASTI2(NCLEF,KK)
05295		KNM=NM
05300	30	CALL CENTER(CENTR)
05400	C   CHECK THE ABOVE  -- FOR P5 HEIGHT CHANGE *********************
05800	C  RJF IS SIZE FACTOR
05900		IF(JE.GT.3.OR.JA.NE.3)GO TO 811
06050	C  0=TREB, 1=BASS, 2=ALTO, 3=TENOR(ALTO SHIFTED UP)
06100		IF(RJE.LT.100)GO TO 812
06200		RSTJC=.8*RSTJC
06300		CENTR=CENTR+RCMIN(JEZ)*RSTJC
06400	C  TO SET HGT. OF MINI CLEFS
06500	812	IF(JEZ.NE.4)GO TO 811
06600		CENTR=CENTR+RSTJC*14
06700		JEZ=3
06800	C   ABOVE IS NOW AT TOP
06900	811	L=JCLEF(JEZ)
06910		IF(NM.EQ.KNM)L=KCLEF(JEZ)+350
07000		IF(JI.EQ.0)GO TO 31
07050		CALL ROTATE(MCLEF,L)
07060	C  RJI=P9=DEGREES OF ROTATION (0-360)
07075		IF(KK.GT.250)KX=0
07175	C CHECK TO SEE IF DATA WAS WIPED OUT.
08110	31	IF(JH.EQ.-2.OR.(JH.NE.-1.AND.IPLT.GE.0))GO TO 32
08120	C			JH=-2 OMITS FILLER DURING PLOT
08200		DO 3 K=L+1,MCLEF(L)+L
08300		IF(MCLEF(K).LT.200000000)GO TO 3
08400		JD=MCLEF(L)-1
08500		IF(K.GT.L+1)JD=JD-K+L+1
08600		CALL FILLMS(JD,MCLEF(K),RJB,CENTR,RJF,RJG)
08620	32	CALL JDRAW(MCLEF(L),RJB,CENTR,RSTJC,RJF,RJG)
08640	C   3,POS.,STF,NT# OR CLEF,ITEM#,SIZEX,SIZEY, JH=-1 TO FILL ON CRT
08680	
08700		RETURN
08800	3	CONTINUE
08900	C  FILLS ONLY WHEN PLOTING OR RJG=-1
09000		END
09100	
09200		SUBROUTINE JDRAW(M,RJB,CENTR,RSTJC,RX,RY)
09300		COMMON/LL/LL
09400		DIMENSION M(1)
09500		RC=RX*RSTJC
09600		RD=RY*RSTJC
09700		DO 2 K=2,M(1)
09800		CALL UNPACK(IA,IB,M(K))
10300	2	CALL LINES(FLOAT(IA)*RC+RJB,FLOAT(IB)*RD+CENTR,LL)
10400		END
10500	
10600		SUBROUTINE CENTER(CNTR)
10700	C  TO CENTER ITEMS CREATED WITH DRAWING PROG.
10800		COMMON /STF/RSTFAC(8),RSTJC
10900		COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)
11000		COMMON/POSI/STF(8),JJB,POS
11100		EQUIVALENCE (RJD,RJQ(2))
11200		CNTR=POS+(2+AMOD(RJD,100.)*7)*RSTJC
11300		END
11400	
11500		SUBROUTINE LINX(A,B,C,D)
11600	C  SAVES SPACE FOR SINGLE LINES.
11700		CALL LINES(A,B,3)
11800		CALL LINES(C,D,2)
11900		END
12000	
12100		SUBROUTINE UNPACK(M,N,I)
12200		COMMON/LL/L
12300	C  L IS FOR VIS. OR INVIS. LINES.
12400		N=I
12500		L=2
12600		M=N/100000000
12700		IF(M.EQ.0)GO TO 2
12800		L=3
12900		N=N-100000000*M
13000	2	M=N/10000
13200		N=MOD(N,10000)
13300		IF(M.GT.1000)M=1000-M
13400		IF(N.GT.1000)N=1000-N
13500		END
13600	
13700		FUNCTION ROFF(R)
13800		S=.5
13900		IF(R)S=-S
14000		ROFF=R+S
14100		RETURN
14200		END